Clickx 115/Clickx 115.iso/software/tools/windows/tails-i386-0.16.iso/live/filesystem.squashfs/usr/share/uim/plugin.scm

Text File | 2010-11-07 | 5.4 KB | 171 lines

;;;
;;; $Id:$
;;;
;;; plugin.scm: Plugin for uim.
;;;
;;; Copyright (c) 2005-2009 uim Project http://code.google.com/p/uim/
;;;
;;; All rights reserved.
;;;
;;; Redistribution and use in source and binary forms, with or without
;;; modification, are permitted provided that the following conditions
;;; are met:
;;; 1. Redistributions of source code must retain the above copyright
;;;    notice, this list of conditions and the following disclaimer.
;;; 2. Redistributions in binary form must reproduce the above copyright
;;;    notice, this list of conditions and the following disclaimer in the
;;;    documentation and/or other materials provided with the distribution.
;;; 3. Neither the name of authors nor the names of its contributors
;;;    may be used to endorse or promote products derived from this software
;;;    without specific prior written permission.
;;;
;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS'' AND
;;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
;;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE
;;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
;;; OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
;;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
;;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
;;; SUCH DAMAGE.
;;;;

(require "util.scm")

(define uim-plugin-lib-load-path
  (if (setugid?)
      (list (string-append (sys-pkglibdir) "/plugin"))
      (let ((home-dir (or (home-directory (user-name)) ""))
        (ld-library-path (getenv "LD_LIBRARY_PATH")))
    (filter string?
        (append (list (getenv "LIBUIM_PLUGIN_LIB_DIR")
                  (if home-dir
                  (string-append home-dir "/.uim.d/plugin")
                  '())
                  (string-append (sys-pkglibdir) "/plugin"))
            ;; XXX
            (if ld-library-path
                (string-split ld-library-path ":")
                '()))))))

(define uim-plugin-scm-load-path
  (if (setugid?)
      (list (sys-pkgdatadir))
      (let ((home-dir (or (home-directory (user-name)) "")))
    (filter string?
        (list (getenv "LIBUIM_SCM_FILES")
              (if home-dir
              (string-append home-dir "/.uim.d/plugin")
              '())
              (sys-pkgdatadir))))))

(define plugin-alist ())
(define plugin-func-alist ())

(define-record 'plugin-entry
  '((name      "")
    ;;(desc      "")
    ;;(author    "")
    ;;(version   #f)
    (library   #f)
    (init-proc #f)
    (quit-proc #f)))

(define plugin-list-append
  (lambda (plugin-name library init quit)
   (let ((entry (plugin-entry-new plugin-name library init quit)))
     (set! plugin-alist
       (append plugin-alist (list entry))))))

(define plugin-list-delete
  (lambda (plugin-name)
    (set! plugin-alist
      (alist-delete plugin-name plugin-alist string=?))))

(define plugin-list-query
  (lambda (plugin-name)
    (assoc plugin-name plugin-alist)))

(define plugin-list-query-library
  (lambda (plugin-name)
    (let ((entry (plugin-list-query plugin-name)))
      (and entry
       (plugin-entry-library entry)))))

(define plugin-list-query-instance-init
  (lambda (plugin-name)
    (let ((entry (plugin-list-query plugin-name)))
      (and entry
       (plugin-entry-init-proc entry)))))

(define plugin-list-query-instance-quit
  (lambda (plugin-name)
    (let ((entry (plugin-list-query plugin-name)))
      (and entry
       (plugin-entry-quit-proc entry)))))


;; The name 'module' is adopted from a post from Hiroyuki. If you
;; feel bad about the meaning of 'module', post your opinion to
;; uim@fdo.

(define installed-im-module-list ())
(define currently-loading-module-name #f)

;;
;; TODO: write test for load-plugin
;; returns whether initialization is succeeded
(define require-module
  (lambda (module-name)
    (set! currently-loading-module-name module-name)
    (let ((succeeded (or (load-plugin module-name)
             (try-require (string-append module-name ".scm")))))
      (set! currently-loading-module-name #f)
      succeeded)))

;; TODO: write test
(define load-module-conf
  (lambda ()
    (let* ((home-dir (or (home-directory (user-name)) ""))
       (user-module-dir (if home-dir
                (string-append home-dir "/.uim.d/plugin/")
                #f))
       (conf-file "installed-modules.scm")
       (user-conf-file (if user-module-dir
                   (string-append user-module-dir conf-file)
                   #f)))
      (try-load conf-file)
      (if (or
       (setugid?)
       (not user-conf-file))
      #f
      (if (not (getenv "LIBUIM_VANILLA"))
          (let ((orig-module-list installed-im-module-list)
            (orig-enabled-list enabled-im-list))
        (if (try-load user-conf-file)
            (begin
              (set! installed-im-module-list
                (append orig-module-list installed-im-module-list))
              (set! enabled-im-list
                (append orig-enabled-list enabled-im-list))))))))))


;; TODO: write test
(define load-enabled-modules
  (lambda ()
    (let* ((home-dir (or (home-directory (user-name)) ""))
       (user-module-dir (if home-dir
                (string-append home-dir "/.uim.d/plugin/")
                #f))
       (file "loader.scm")
       (user-file (if user-module-dir
              (string-append user-module-dir file)
              #f)))
      (and (try-load file)
       (or (and (not (setugid?))
            user-file
            (try-load user-file))
           #t)))))